REBOL [
 Title: "another rebol-bases xml-format"
 File: %index-xml.r
]

context[

new-lines: func [blk] [
	foreach val blk [
		if block? val [
			new-lines val
			new-line blk true
		]
	]
	blk
]

upper-chars: charset [#"A" - #"Z"]
mark-upper: func [str /local char] [
	forall str [
		if find/case upper-chars char: str/1 [
			str: insert str "*"
		]
	]
	str
]
unmark-upper: func[str][
 forall str[
  if #"*" = first str[
  	remove str
  	uppercase/part str 1
  ]
 ]
 str
]

global/load-xml: func [string /local res] [
    res: index-xml parse-xml string
    reduce[res/1 'a res/2 'b res/3]
]

global/index-xml: func [tag-blk /local val] [
	new-lines tag-blk
	;tag-blk/1: join http://myns/ tag-blk/1
	; attribute
	if block? val: tag-blk/2 [
		forskip val 2 [
			val/1: mark-upper val/1
			val/1: either  find  val/1 ":" [to-url val/1][to-word val/1]
		]
	]

	;switch attempt[tag-blk/2/type][
	; "logic"[ tag-blk/2/value: to-logic tag-blk/2/value]
	; "date"[tag-blk/2/value: to-date tag-blk/2/value]
	;]

	; body
	if block? val: tag-blk/3 [
		forall val [
			if block? val/1 [
				val: insert val to-word mark-upper copy val/1/1
				new-line back val true
				index-xml val/1
				val/1: reduce[val/1/1 'a val/1/2 'b val/1/3]
			]
		]
	]
	tag-blk
]

assert: func [[catch] string [string! block!] cond] [
	if not cond [
		throw make error! mold reduce string
	]
]

pop: func [blk /local res] [
	res: last blk
	remove back tail blk
	res
]


; TODO addapt it.

global/mold-xml-body: func [indexed /local out p body-rule tag-rule msg] [
	out: copy ""
	names: copy []
	tag-rule: [
		(msg: "tag")
		p: [string! | word!] (
			repend out ["<" p/1]
			append names p/1
		)
		(msg: "attribs")
		'a
		p: [into [
				any [
					p: [word! | url!] string! (repend out [" " unmark-upper to-string p/1 "=^"" encode-xml-string p/2 "^""])
				]
			] | none! ]
		(msg: "body")
		'b
		p: [into [
				(repend out [">"])
				body-rule
				(repend out ["</" last names ">"])
			] | none! (repend out ["/>"])]
		(pop names)
	]
	if not parse indexed body-rule: [
			(msg: "in body")
		any[
			p: string! (repend out [encode-xml-string p/1])
			| [word! | url!] into tag-rule
		]
	][make error! remold ["to-xml failed" msg p out]] 
	out
]

global/wrap-xml: func [xml] [
	head insert insert xml <?xml version="1.0" encoding="UTF-8"?> "^/"
]
]

;TODO parse-xml does not know tags with namespaces?

/do [
print "testing index-xml"
;do %mezz.r
	blk: load-xml probe {
<?xml version="1.0" encoding="UTF-8"?>
<ListAllMyBucketsResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
  <Owner DummyVal="1" ns:DummyVal="2">
    <ID>bcaf1ffd86f41caff1a493dc2ad8c2c281e37522a640e161ca5fb16fd081034f</ID>
    <DisplayName>webfile</DisplayName>
  </Owner>
  <Buckets>
    <Bucket>
      <Name>quotes;/Name>
      <CreationDate>2006-02-03T16:45:09.000Z</CreationDate>
    </Bucket>
    <Bucket>
      <Name>samples</Name>
      <CreationDate>2006-02-03T16:41:58.000Z</CreationDate>
    </Bucket>
  </Buckets>
</ListAllMyBucketsResult>	
	}
	?? blk
	probe wrap-xml mold-xml-body blk/b
	wait 4 quit
]
